home *** CD-ROM | disk | FTP | other *** search
- unit DragDropForm;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, ComCtrls, ExtCtrls;
-
- type
- TMainForm = class(TForm)
- DragImages: TImageList;
- DragSource: TStaticText;
- Target: TImage;
- procedure DragSourceMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure DragSourceMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure DragSourceMouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- private
- ImageIndex: Integer;
- end;
-
- var
- MainForm: TMainForm;
-
- implementation
-
- {$R *.DFM}
-
- procedure TMainForm.DragSourceMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- Randomize;
- ImageIndex := Random (DragImages.Count);
- DragImages.SetDragImage (ImageIndex, 0, 0);
- DragImages.DragCursor := crDefault;
- DragImages.BeginDrag (Self.Handle, DragSource.Left + X, DragSource.Top + Y);
- end;
-
- procedure TMainForm.DragSourceMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- MousePos: TPoint;
- TargetControl: TControl;
- begin
- DragImages.EndDrag;
- // Find out what's under the mouse.
- MousePos.X := DragSource.Left + X;
- MousePos.Y := DragSource.Top + Y;
- TargetControl := Self.ControlAtPos (MousePos, True);
- if TargetControl = Target then begin
- DragImages.GetIcon (ImageIndex, Target.Picture.Icon);
- end;
- end;
-
- procedure TMainForm.DragSourceMouseMove(Sender: TObject; Shift: TShiftState;
- X, Y: Integer);
- begin
- if DragImages.Dragging then begin
- DragImages.DragMove (DragSource.Left + X, DragSource.Top + Y);
- end;
- end;
-
- end.
-